let rec string_of_list pr ls = 
	match ls with
	| [] -> ""
	| x::xs -> (pr x)^(string_of_list pr xs);;

(* LISTS *)
let ls2 = [`a;`a;`a;`a;`b;`c;`c;`a;`a;`d;`e;`e;`e;`e];;

(* Implement a function that would remove
   duplicates that occur consecutively.
   For example:
      compress [1;1;2;2;1] ==> [1;2;1]
*)

let compress (xs:'a list) : 'a list =
  let rec helper (ls:'a list) (curr:'a) (acc:'a list): 'a list= 
		match ls with
		| [] -> acc
		| z::zs -> if	(z==curr) then helper zs curr acc
									else helper zs z (z::acc)
	in helper xs (List.hd xs) []
;;

compress ls2;;
(* val compress : 'a list -> 'a list = <fun> *)
(* - : [> `a | `b | `c | `d | `e ] list = [`a; `b; `c; `a; `d; `e] *)

(* Implement a function that would remove
   all duplicates in a list.
   For example:
      removeDupl [1;1;2;2;1] ==> [1;2]
*)
let removeDupl (xs:'a list) : 'a list =
  let rec helper (acc:'a list) (origin:'a list) = 
		match origin with
		| [] -> List.rev acc
		| y::ys -> if List.mem y acc then helper acc ys
		             else helper (y::acc) ys
	in helper [] xs
;;

removeDupl ls2;;
(* val removeDupl : 'a list -> 'a list = <fun> *)
(* - : [> `a | `b | `c | `d | `e ] list = [`a; `b; `c; `d; `e] *)

(*
Implement a function which given a list of lists L returns the intersection
of all the lists in L. The order of the elements does not matter.
*)

let intersect_all (xss: 'a list list) : 'a list =
	let intersect_two (xs:'a list) (ys:'a list):'a list = 
		let rec helper (ls1:'a list) (ls2:'a list) (acc:'a list) = 
			match ls1 with 
			| [] -> acc
			| z::zs -> if List.mem z ls2 then helper zs ls2 (z::acc) else helper zs ls2 acc
		in helper xs ys []
	in match xss with
	| [] -> []
	| hd::tl -> List.fold_left intersect_two hd tl
;;

(* intersect_all : 'a list list -> 'a list *)
(*
# intersect_all [[1; 2; 3]; [2; 3; 4]; [3; 4; 5]];;
- : int list= [3] 
*)


let ls3 = [3;6;7;3;4;8;3;3;3];;

(* Implement a function that would return the
   first element in a list that satisfies a given predicate
   For example:
      findFirst (fun x -> x>1) [1;1;2;1;4;1] ==> Some 2
      findFirst (fun x -> x>4) [1;1;2;1;4;1] ==> None
*)
let findFirst (p:'a->bool) (xs:'a list) : 'a option =
	let rec helper (xs:'a list) = 
		match xs with
		| [] -> None
		| y::ys -> if p y then Some y else helper ys
	in helper xs
;;

findFirst (fun x -> x mod 2 = 0) ls3;;
(* val findFirst : ('a -> bool) -> 'a list -> 'a option = <fun> *)
(* - : int option = Some 6 *)

(* Implement a function that would return the
   last element in a list that satisfies a given predicate
   For example:
      findLast (fun x -> x>1) [1;1;2;1;4;1] ==> Some 2
      findLast (fun x -> x>4) [1;1;2;1;4;1] ==> None
*)
let rec findLast (p:'a->bool) (xs:'a list) : 'a option =
	let rec helper (ys:'a list) (last:'a option) = 
		match ys with
		| [] -> last
		| z::zs -> if p z then helper zs (Some z)
		             else helper zs last
	in helper xs None
;;

findLast (fun x -> x mod 2 = 0) ls3;;
(* val findLast : ('a -> bool) -> 'a list -> 'a option = <fun> *)
(* - : int option = Some 8 *)

(* Given a number n>1, generate all possible
   pairs of positive numbers (a,b) such that n=a+b 
   For example:
     genPairs 3 ===> [(1,2);(2;1)]
*)

let genPairs (n:int) : (int * int) list =
  let rec helper (counter:int) (acc:(int*int) list): (int*int) list = 
		if counter < n then helper (counter+1) ((counter, n-counter)::acc)
		else acc
	in helper 1 []
;;

genPairs 6;;

(* val genPairs : int -> (int * int) list = <fun> *)
(* - : (int * int) list = [(1, 5); (2, 4); (3, 3); (4, 2); (5, 1)] *)

(* NUMBERS *)

(* Given a number n, return true if it is a prime number
   otherwise return false
     isPrime 2 ==> true
     isPrime 4 ==> false
*)
let isPrime (n:int) : bool =
  let sqrt_n = truncate (sqrt (float n)) in
  let rec helper k = 
    if k<=1 then true
    else if n mod k==0 then false
      else helper (k-1) in
  helper sqrt_n;;

isPrime 13;;
(* val isPrime : int -> bool = <fun> *)
(* - : bool = true *)

(* 
   Given a range of integers by its lower and upper limit, 
   construct a list of all prime numbers in that range. 
   For example:
      allPrimes 10 2 ==> []
      allPrimes 2 10 ==> [2;3;5;7]
*)

let allPrimes (x:int) (y:int) : int list =
  let rec helper (acc:int list) (counter:int) = 
		if counter > y then List.rev acc 
		else if isPrime counter then helper (counter::acc) (counter+1) 
		else helper acc (counter+1)
	in if x > y then [] 
	   else if x == 1 then helper [] (x+1)
		 else helper [] x
;;

allPrimes 1 100;;
(* val allPrimes : int -> int -> int list = <fun> *)
(* - : int list = *)
(* [1; 2; 3; 5; 7; 11; 13; 17; 19; 23; 29; 31; 37; 41; 43; 47; 53; 59; 61; 67; 71; 73; 79; 83; 89; 97] *)

(* 
    Given a number, return its prime factors.
    For example:
      pfactors 6  ==> [2;3]
      pfactors 12 ==> [2;2;3]
*)

let pfactors (n:int) : int list =
	let divisible (s:int) (t:int) : bool = 
		let quo = s / t in
		let p = quo * t in p == s
	in let rec helper (acc:int list) (num:int) (counter:int) = 
  		if counter<=1 then acc
  		else if num <= 1 then acc
  		else if divisible num counter then (
							if isPrime counter then helper (counter::acc) (num/counter) (num / counter - 1) 
							else helper acc num (counter-1) 
			)
			else helper acc num (counter-1)
	in helper [] n (n-1)
;;

pfactors 315;;
(* val pfactors : int -> int list = <fun> *)
(* - : int list = [3; 3; 5; 7] *)

(* 
    Given a number, return a list of 
     unique prime factors and their occurrences.
    For example:
      pfactorsM 6  ==> [(2,1);(3,1)]
      pfactorsM 12 ==> [(2,2);(3,1)]
*)

let pfactorsM (n:int) : (int * int) list =
  let ls = pfactors n in
	let uniqueList = removeDupl ls in
	let rec count_y (y:int) (count:int) (xs:int list): int= 
		 match xs with
		| [] -> count
		| z::zs -> if z == y then count_y y (count+1) zs 
									else count_y y count zs
	in let rec helper (lst:int list) (allList:int list) (acc:(int*int) list):(int*int) list= 
			match lst with
			| [] -> acc
			| z::zs -> let count_z = count_y z 0 allList in 
										helper zs allList ((z,count_z)::acc)
	in helper uniqueList ls [] 
;;

pfactorsM 315;;
(* val pfactorsM : int -> (int * int) list = <fun> *)
(* - : (int * int) list = [(3, 2); (5, 1); (7, 1)] *)

(*
   Goldbach's conjecture says that every positive even number greater 
   than 2 is the sum of two prime numbers. Example: 28 = 5 + 23. It is 
   one of the most famous facts in number theory that has not been proved 
   to be correct in the general case. It has been numerically confirmed 
   up to very large numbers. Write a function to find the two prime 
   numbers that sum up to a given even integer.
   For example:
      goldbach 4 ==> (2,2)
      goldbach 8 ==> (3,5)
*)
let goldbach (n:int) : (int*int) =
  let lst = allPrimes 1 n in
	let rec helper (ls:int list) (num:int): (int*int) = 
		match ls with 
		| [] -> failwith "No such combination of prime numbers"
		| z::zs -> if List.mem (num-z) ls then (z,num-z)
								else helper zs num
	in 
	print_endline (string_of_list (fun (x:int) -> string_of_int x) lst);
	if n <= 2 then failwith "The number supplied has to be greater than 2"
	else helper lst n
;;

goldbach 28;;
(* val goldbach : int -> int * int = <fun> *)
(* - : int * int = (5, 23) *)


(* TREES *)


type 'a tree = Leaf of 'a | Node of 'a * ('a tree) * ('a tree)

let bt1 = Node (1,(Leaf 2),Node (3,(Leaf 4),(Leaf 5)));;

(*
   Write a function that would count the number of leaves
   in a given binary tree
   For example:
     countL (Leaf 0) ==> 1
     countL (Node(0,(Leaf 0),Node(0,Leaf 0,Leaf 0))) ==> 3
*)
let rec countL (t:'a tree) : int =
	match t with
	| Leaf _ -> 1
	| Node (x,lt,rt) -> 1 + (countL lt) + (countL rt)
;;

countL bt1;;
(* val countL : 'a tree -> int = <fun> *)
(* - : int = 3 *)

(* A tree is perfectly balanced if either it is a leaf
   or it is a node with two subtrees of the same height and also
   perfectly balanced. Write a function that takes a height
   value and then returning a perfect tree of that height with 
   all its elements set to 1 
  For example:
    perfectTree 2 ==> Node (1, Leaf 1, Leaf 1)
*)
let perfectTree n =
  let rec helper (height:int) (t:'a tree) = 
		if height <= 0 then t
		else helper (height-1) (Node (1,t,t))
	in if n < 1 then failwith "The number supplied has to be positive"
			else helper (n-1) (Leaf 1)
;;

perfectTree 3;;
(* val perfectTree : int -> int tree = <fun> *)
(* - : int tree = Node (1, Node (1, Leaf 1, Leaf 1), Node (1, Leaf 1, Leaf 1)) *)


(* HIGHER-ORDER *)

(* 
   Given two lists, return a list of all possible
   pairs of the two lists.
   For example prod [1;2] [`a;`b] would
   return [(1,`a);(1,`b);(2,`a);(2,'b)]
   Use higher-order List.map to help you in this task.
*)

let rec prod (xs:'a list) (ys:'b list) : ('a * 'b) list =
  let f x =
		 let rec helper x ls (acc:('a*'b) list)= 
			match ls with
			| [] -> acc
			| z::zs -> helper x zs ((x,z)::acc)
	    in helper x ys []
	in let lsList = List.map f xs in
	List.concat lsList
;;

prod [1;2] [`a;`b;`c];;
(* val prod : 'a list -> 'b list -> ('a * 'b) list = <fun> *)
(* [(1, `a); (1, `b); (1, `c); (2, `a); (2, `b); (2, `c)] *)

(* polymorphic rose tree *)
type 'a roseTree = 
  | NodeR of 'a * (('a roseTree) list)

let rt2 = NodeR (1,[NodeR (2,[]);NodeR (3,[NodeR(4,[])]);NodeR(5,[])]);;

(* 
   We can flatten a rosetree into a list in prefix fashion
   by putting value at node, followed by values of each 
   of the subtrees.
   Implement a first-order version of this prefixRT
   method without using any higher-order functions.
   For example:
     prefixRT (NodeR(4,[NodeR (1,[]); NodeR (2,[])]))  ==> [4;1;2]
   Below is a first-order implementation.
*)

let rec prefixRT (xs:'a roseTree) : 'a list =
  match xs with
    | NodeR (x,lrt) -> x :: comb_prefixRT lrt

and comb_prefixRT (xs:('a roseTree) list) : 'a list =
  match xs with
    | [] -> []
    | x::xs -> (prefixRT x)@comb_prefixRT xs;;

prefixRT rt2;;
(* val comb_prefixRT : 'a roseTree list -> 'a list = <fun> *)
(* - : int list = [1; 2; 3; 4; 5] *)

prefixRT (NodeR(4,[NodeR (1,[]); NodeR (2,[])]));;

(* 
   write a higher-order counterpart for prefixRT 
   Use higher-order function List.fold_right to help
   you in this method.
*)
let rec prefixRTHO (xs:'a roseTree) : 'a list =
	let f (ys:'a roseTree) (zs:'a list) = (prefixRTHO ys)@zs
	in match xs with
	| NodeR (x,[]) -> [x]
	| NodeR (x,xxs) -> x::(List.fold_right f xxs [])
;;

prefixRTHO rt2;;
(* val prefixRTHO : 'a roseTree -> 'a list = <fun> *)
(* - : int list = [1; 2; 3; 4; 5] *)

(* 
   write a higher-order counterpart for postfixRT 
   Use higher-order function List.fold_right to help
   you in this method.
*)
let rec postfixRTHO (xs:'a roseTree) : 'a list =
	let f (ys:'a roseTree) (zs:'a list) = (postfixRTHO ys)@zs
	in match xs with
	| NodeR(x,[]) -> [x]
	| NodeR(x,xss) -> (List.fold_right f xss [])@[x]
;;

postfixRTHO rt2;;
(* val postfixRTHO : 'a roseTree -> 'a list = <fun> *)
(* - : int list = [2; 4; 3; 5; 1] *)


(* 
   We can denote rose trees as strings of the following form: 
    "a(b(d,e),c,f(g))".
   Write an OCaml function which generates such a string representation
   for rose tree.
   You are to use a higher-order function pr_args below
   which prints a list of items separated by comma.
*)

let pr_args (pr:'a->string) (xs:'a list) : string =
  let rec aux xs =
    match xs with
      | [] -> failwith "pr_args must not have [] input"
      | [x] -> pr x
      | x::xs -> (pr x)^","^(aux xs) 
  in aux xs;;

let rec string_of_RT (pr:'a -> string) (xs:'a roseTree) : string =
  match xs with
    | NodeR (v,ls) -> (pr v)^"("^(aux pr ls)^")"

and aux (pr:'a -> string) (ls:('a roseTree) list):string =
	let aux_2 (xs:'a roseTree) = string_of_RT pr xs in
	pr_args aux_2 ls
;;

print_endline (string_of_RT (string_of_int) rt2);;
(* val string_of_RT : ('a -> string) -> 'a roseTree -> string = <fun> *)
(* - : string = "1(2,3(4),5)" *)

(*
Write a recursive function apply_n_times which given a non-negative integer n and a function
f outputs the n-fold composition of f with itself.
i.e. apply_n_times n f x = f(f(f(f(f ...(f x) ...))))
Observe that apply_n_times 0 f is equivalent to the identity function
and that apply_n_times 1 f is equivalent to f itself.
*)

let rec apply_n_times (n:int) (f:'a -> 'a) (x: 'a): 'a = 
	if n == 0 then x 
	else apply_n_times (n-1) f (f x)
;;

(* apply_n_times : int-> ('a -> 'a) -> 'a -> 'a *)
(* apply_n_times 3000 (fun x -> x-1) 6110;; *)
(* - : int = 3110 *)

(*
write a function succ that when given a function equivalent to apply_n_times n as above, will
provide a function equivalent to apply_n_times (n+1) 
*)

let succ (af: ('a -> 'b) -> 'c -> 'a) (f: 'a ->'b) (x:'c) : 'b = 
	let res = af f x in
	f res
;;

(* succ : (('a -> 'b) -> 'c -> 'a) -> ('a ->'b) -> 'c -> 'b *)
(*
# let square = fun x -> x*x;;
val square : int -> int

# apply_n_times 0 square 2;;
- : int = 2

# succ (apply_n_times 0) square 2;;
- : int = 4

# succ (succ (apply_n_times 0)) square 2;;
- : int = 16

# succ (succ (succ (apply_n_times 0))) square 2;;
- : int = 256
*)